Example data

library(tidyverse)

set.seed(42)
n <- 1000
x <- seq(0, 3, length = n)
Ey <- (sin(3 * x) + 2 * sin(2 * x^2) + 3 * sin(x^3)) / exp(x)
y <- rnorm(n, mean = Ey, sd = 0.2)

mar <- c(2, 2, 2, 2)
xlim<-c(0,3)
ylim <- c(-1.75, 2.5)
cex <- 0.5

par(mar = mar)
plot(x, y, pch = 19, col = "grey", xlim = xlim, ylim = ylim, cex = cex)
lines(x, Ey, lwd = 2)


Polynomials

Basis functions

for(degree in c(5, 10)) {
  X = poly(x, degree, raw = TRUE)
  plot(x, y, type = "n", xlim = xlim, ylim = ylim,
       main = paste0("Polynomial basis functions: degree ", degree))
  abline(h = 1, lwd = 2)
  for(i in 1:ncol(X)) lines(x, X[,i], col=i+1, lwd=2)
}

Fitted models

for(degree in c(5, 10, 50, 200)){
  X = poly(x, degree, raw = TRUE)
  model = lm(y ~ X)
  plot(x, y, type = "n", ylim = ylim, 
       main = paste("Polynomial fitted model: degree", degree))
  points(x, y, pch = 19, col = "grey", cex = cex)
  lines(x, fitted(model), col = "blue", lwd = 2)
  legend("topright", paste("AIC =", signif(AIC(model), 3)))
}


Truncated power series

Basis functions

for (degree in c(1, 3)) {
  n_knots <- 12
  df <- n_knots + 1
  knots <- seq(0, 3, length = df)[1:n_knots]
  X <- 1:n_knots %>% 
    map_dfc(function(k){
      if_else(x < knots[k], 0, (x - knots[k])^degree)
    }) %>% 
    as.matrix
  plot(x, y, type = "n", ylim = ylim, 
       main = paste0(main = "TPS basis functions: degree ", degree, ", knots ", n_knots))
  for (k in 1:n_knots) {
    lines(x[X[, k] != 0], X[X[, k] != 0, k], col = k + 1)
  }
  abline(h = 1)
  abline(v = knots, lty = 2, col = "grey")
}

Fitted models

for (n_knots in c(12, 24)) {
  for (degree in c(1, 3)) {
    df <- n_knots + 1
    knots <- seq(0, 3, length = df)[1:n_knots]
    X <- 1:n_knots %>% 
      map_dfc(function(k){
        if_else(x < knots[k], 0, (x - knots[k])^degree)
      }) %>% 
      as.matrix
    model <- lm(y ~ X)
    plot(x, y, type = "n", ylim = ylim, 
         main = paste0(main = "TPS fitted model: degree ", degree, ", knots ", n_knots))
    points(x, y, pch = 19, col = "grey", cex = cex)
    lines(x, fitted(model), col = "blue", lwd = 2)
    legend("topright", paste("AIC =", signif(AIC(model), 3)))
  }
}


B-splines

Basis functions

make_knots = function(degree, n_knots_internal) {
  knots <- seq(0, 3, length = n_knots_internal + 2)
  knots[-c(1, length(knots))]
}
make_X = function(degree, knots) {
  df <- length(knots) + degree + 1
  X = splines::bs(x = x, knots = knots, degree = degree, intercept = TRUE)
  as.matrix(X)
}
plot_X = function(X, knots = NULL, main = "") {
  plot(x, y, type = "n", ylim = ylim, 
       main = paste0(main = "B-spline basis functions: degree ", degree, ", internal knots ", length(knots)))
  for (k in 1:ncol(X)){
    lines(x[X[, k] != 0], X[X[, k] != 0, k], col = k + 1)
  }
  if (!is.null(knots)) {
    abline(v = c(0, knots, 3), lty = 2, col = "grey")
  }  
}
for(n_knots_internal in 11){
  for(degree in c(1, 3)){
    knots <- make_knots(degree, n_knots_internal)
    X <- make_X(degree, knots)
    plot_X(X, knots, main = "")
  }
}

Fitted models


Cubic splines

Basis functions

Fitted models


Bias vs Variance